COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE REFACE
C00007 00003	SUBR(REFACE,BODY,NUMBER)	MAKE N CUTS ALONG Z AXIS.
C00010 00004	SUBN(BOUNDS,BODY)		MAKE BOUNDS CUBE.
C00012 00005	SUBR(SLICE0,BDYSET)	SLICE A SET OF BODIES AT ZCUT LEVEL.
C00015 00006	SUBN(VMARK,BODY)	    MARK THE VERTICES OF A BODY AS PZ OR NZ.
C00017 00007	SUBN(FECUT,BODY)	    FACE EDGE CUTTING.
C00021 00008	SUBR(SMOOTH,FACE,EPSILON)
C00024 00009	SUBN(MKGHOST,OLDSLAB)
C00027 00010	SUBN(DPYF,FACE)
C00030 00011	SUBN(VMATE)
C00032 00012	SUBN(RESURRECT)
C00036 00013	SUBN(GLUEVV,VERT1,VERT2)
C00041 ENDMK
C⊗;
TITLE REFACE

COMMENT ⊗------------------------------------------------------------

	REFACE  resurfaces a  polyhedron by  cutting  it into  slabs,
simplifing the  slabs, and then glueing the  slabs back together. The
process destroys the orginal polyhedron a slab at a time.

The two  main intermediate  data  structures are  the set  of  pieces
remaining of the  original body after each slice, BSET1;  and the set
of  cross sectional face lamina bodies  that are generated, BSET2. As
the process runs, BSET1 decreases from the given  polyhedron to null,
and BSET2  increases from null into the new smoothed resurfce body.

	Naturally there are wheels within wheels: the outmost loop is
in  REFACE which cycles  from ZMIN to  ZMAX making SLABs.   The next
significant loop is in SLICE0 which first cycles thru the set of body
pieces marking vertices (using VMARK)  and collecting a list of lists
of  edges (using FECUT);  next SLICE0  cycles thru the  list of lists
removing the  very short edges  (created by  FECUT) which results  in
UNGLUEing the two sides of a slice, leaving to fresh slice faces, the
upper one of which is then cons'ed into the list FSET1.
--------------------------------------------------------------------⊗

	EXTERN ESPLIT,INVERT,OTHER,VCCW,MKFE,ECCW,KLFE,GEODPY
	EXTERN BGET,BATT,KLBFEV,MKCOPY,MKCUBE,TRANSL,MKB,KLEV
	EXTERN FCW,FCCW,FACOEF
	↓PZ ← 1B28
	↓NZ ← 1B29
	↓WASP ← 1B5
;--------------------------------------------------------------------
	ZCUT:	0	;CURRENT ZCUT LEVEL.
	ZDELTA:	0	;ZCUT INTERVAL.

	BSET1:	0	;SET OF ORIGINAL BODIES.
	BSET2:	0	;SET OF RESULTING BODIES.

	FSET1:	0	;SET OF ORIGINAL SLICE FACES (PZ) OM CAR8,,CDR8.
	ELIST1:	0	;LIST OF VERY SHORT EDGES IN ALT LINKS.
	ELIST2:	0	;LIST OF LAST SHORT EDGES IN ALT2 LINKS.

	DECLARE{XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX}
BUFFER:	BLOCK 1000

	CFLIST:	0	;SMOOTHED CUT FACE LAMINA LIST - ALT LINK OF FACES.
	VLIST:	0	;VERTICES OF SMOOTH CUT FACE LAMINA OF A SLAB.
SUBR(REFACE,BODY,NUMBER)	;MAKE N CUTS ALONG Z AXIS.
;--------------------------------------------------------------------
;INITIALIZE BSET1 AND BSET2.
	SETQ(BSET1,{MKB,[0]})		;ORIGINAL BODY (AND ITS PIECES).
	CALL(BATT,BODY,BSET1)
	SETQ(BSET2,{BOUNDS,BODY})	;RESULTING BODIES.
;Z SECTION WIDTH.
	LAC 0,ZMAX↔LAC 1,ZMIN↔FSBR 0,1↔DAC 1,ZCUT
	LAC 1,NUMBER↔DACN 1,COUNT#↔AOS 1
	FSC 1,233↔FDVR 0,1↔DAC 0,ZDELTA
;LOOP FOR CUTTING CROSS SECTIONS.
L1:	LAC ZDELTA↔FADRM ZCUT
	CALL(SLICE0,BSET1)		;MAKE SLICE AT ZCUT.
	CALL(KLNBDY)			;KILL PIECES BELOW SLICE LEVEL.
;	CALL(GEODPY)
	AOSGE COUNT↔GO L1
	CALL(KLBFEV,BSET1)
	CALL(KLBFEV,BSET2)
	LAC 1,SLAB2↔POP2J
ENDR REFACE;1/15/74(BGB)---------------------------------------------

SUBN(KLNBDY)		;KILL NEGATIVE BODIES OF THE FSET1 LIST.
;--------------------------------------------------------------------
	ACCUMULATORS{F}
;GET NEGATIVE CUT FACE AND TEST FOR ITS EXISTENCE.
	LAC 1,FSET1
L1:	DAC 1,F1#↔HLRE 1,6(1)		;SIGNED ALT LINK. -1 DEAD CUT FACE.
	JUMPLE 1,L2
	PED 1,1↔CCW 1,1↔DAC 1,SLAB1	;BODY FETCH THE OLD SLAB.
;KILL AND RESURRECT THE SLAB BODY.
	CALL(MKGHOST,SLAB1)		;MAKE GHOST OF THE SLAB.
;	CALL(VMATE)			;FIND CLOSET NEIGHBORING VERTEX.
	CALL(DPYALL)
;	SETQ(SLAB2,{RESURRECT})		;TURN THE GHOST INTO A NEW BODY.
	CALL(KLBFEV,SLAB1)		;KILL A NEGATIVE SLAB BODY.
L2:	LAC 1,F1↔CDR 1,8(1)		;ADVANCE DOWN CUT FACE LIST.
	JUMPN 1,L1↔POP0J		;EXIT.
ENDR KLNBDY;1/15/74(BGB)---------------------------------------------
DECLARE{SLAB1,SLAB2}
SUBN(BOUNDS,BODY)		;MAKE BOUNDS CUBE.
;--------------------------------------------------------------------
	ACCUMULATORS{B,V,XLO,XHI,YLO,YHI,ZLO,ZHI}

;FIND COORDINATE EXTREMA.
	HRLOI XLO,377777↔HRLZI 400000
	HRLOI YLO,377777↔HRLZI 400000
	HRLOI ZLO,377777↔HRLZI 400000
	LAC B,BODY↔LAC V,B
L1:	PVT V,V↔CAMN V,B↔GO L2
	CAMLE XLO,XWC(V)↔LAC XLO,XWC(V)↔CAMGE XHI,XWC(V)↔LAC XHI,XWC(V)
	CAMLE YLO,YWC(V)↔LAC YLO,YWC(V)↔CAMGE YHI,YWC(V)↔LAC YHI,YWC(V)
	CAMLE ZLO,ZWC(V)↔LAC ZLO,ZWC(V)↔CAMGE ZHI,ZWC(V)↔LAC ZHI,ZWC(V)
	GO L1

;MAKE BOUNDS CUBE AND TRANSLATE IT TO PROPER POSITION.
L2:	DAC XLO,XMIN↔DAC XHI,XMAX
	DAC YLO,YMIN↔DAC YHI,YMAX
	DAC ZLO,ZMIN↔DAC ZHI,ZMAX
	FSBR XHI,XLO↔FADR XLO,XMAX↔FSC XLO,-1↔PUSH P,XLO
	FSBR YHI,YLO↔FADR YLO,YMAX↔FSC YLO,-1↔PUSH P,YLO
	FSBR ZHI,ZLO↔FADR ZLO,ZMAX↔FSC ZLO,-1↔PUSH P,ZLO
	SETQ(BSET2,{MKCUBE,XHI,YHI,ZHI})
	POP P,ZLO↔POP P,YLO↔POP P,XLO
	CALL(TRANSLATE,BSET2,XLO,YLO,ZLO)
	LAC 1,BSET2↔POP1J

ENDR BOUNDS;1/15/74(BGB)---------------------------------------------
SUBR(SLICE0,BDYSET)	;SLICE A SET OF BODIES AT ZCUT LEVEL.
;--------------------------------------------------------------------
;INITIALIZATION.
	DZM ELIST2	;LIST OF LISTS OF SHORT EDGES.
	DZM FSET1	;LIST OF PZ SLICE FACES.
;LOOP FOR CUTTING BODIES OF THE BODY SET.
	LAC 1,BDYSET↔SON 1,1↔DAC 1,B0↔DAC 1,B	;INIT THE LOOP.
L1:	CALL(VMARK,B)				;MARK VERTICES PZ & NZ.
	SKIPN PZCNT↔GO .+3			;PIECE FULLY BELOW.
	SKIPE NZCNT↔GO[CALL(FECUT,B)↔GO .+1]	;CUT FACES AND EDGES.
	LAC 1,B↔BRO 2,1↔DAC 2,B			;ADVANCE ALONG BODY RING.
	SKIPN PZCNT↔GO[CALL(KLBFEV,1)↔GO .+1]	;KILL PIECE FULLY BELOW.
	LAC 1,B↔CAME 1,B0↔GO L1			;...AND FALL THRU.
;--------------------------------------------------------------------
;SLICE THE SOLID  -  MAPCAR UNGLUE DOWN THE ALT2 EDGE LIST 2.
L2:	SKIPN 2,ELIST2↔GO L5
	ALT2 1,2↔DAC 1,ELIST2
	DAC 2,ELIST1

;KILL THE TIES THAT BIND  -  MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L3:	SKIPN 2,ELIST1↔GO L4
	ALT 1,2↔DAC 1,ELIST1
	PFACE 0,2↔DAC 0,FACE1
	SETQ(FACE2,{KLFE,2})↔GO L3

;PLACE THE NEW FACES OF THE SLICE INTO A RING.
L4:	LAC 1,FACE1↔LAC 2,FACE2
	ALT. 1,2↔ALT. 2,1			;TWO NEW FACES.
	TEST 1,PZ↔EXCH 1,2
	LAC 4,FSET1↔DAP 4,8(1)↔DAC 1,FSET1	;CDR8 LINK.
	GO L2
;--------------------------------------------------------------------
;UPDATE SET OF POSITIVE BODIES IN BSET1.
L5:	LAC 1,FSET1↔DAC 1,FACE1
L6:	PED 1,1↔CCW 1,1↔CALL(BATT,1,BSET1)
	LAC 1,FACE1↔CDR 1,8(1)↔DAC 1,FACE1	;ADVANCE CUT-FACE RING.
	JUMPN 1,L6↔LAC 1,FSET1↔POP1J

DECLARE{EDGE,FACE1,FACE2,B,B0}
ENDR SLICE0;1/12/74(BGB)---------------------------------------------
SUBN(VMARK,BODY)	    ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
;--------------------------------------------------------------------
	ACCUMULATORS{V,PDEL,NDEL,E,E0}

;CLEAR THE NZ AND PZ BITS OF ALL THE EDGES AND VERTICES.
	DZM PZCNT↔DZM NZCNT
	LACI PZ+NZ↔LAC 1,BODY
	ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3
	ANDCAM(1)↔PED 1,1↔CAME 1,BODY↔GO .-3

;POSITIVE AND NEGATIVE EPSILON.
	LAC PDEL,ZCUT↔FADR PDEL,[0.01]
	LAC NDEL,ZCUT↔FSBR NDEL,[0.01]

;FORCE THE VERTICES TO BE ABOVE OR BELOW THE SLICE PLANE.
	LAC V,BODY
L1:	PVT V,V↔CAMN V,BODY↔POP1J

L2:	LAC ZWC(V)
	CAML PDEL↔GO[MARK V,PZ↔AOS PZCNT↔GO L3]
	CAMG NDEL↔GO[MARK V,NZ↔AOS NZCNT↔GO L3]
	FSBR ZCUT
	SKIPL ↔DAC PDEL,ZWC(V)
	SKIPGE↔DAC NDEL,ZWC(V)↔GO L2

;MARK THE EDGES OF THIS VERTEX AS PZ OR NZ.
L3:	PED E,V↔LAC E0,E
L4:	PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO L5	   ;AC1 ← ECCW(E,V).
	NVT 1,E↔CAME 1,V↔GO L1 ↔NCW 1,E
L5:	IORM 0,(E)↔LAC E,1			;AC0 CONTAINS THE BIT.
	CAME E,E0↔GO L4↔GO L1

ENDR VMARK;1/11/74(BGB)---------------------------------------------

	DECLARE{PZCNT,NZCNT}
SUBN(FECUT,BODY)	    ;FACE EDGE CUTTING.
;--------------------------------------------------------------------
	ACCUMULATORS{V2,V1,DX,DY,DZ}
;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
	LAC 1,BODY↔DAC 1,EDGE#
L0:	LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE	;ADVANCE ALONG EDGE RING.
	CAMN 1,BODY↔POP1J		;TEST FOR END OF EDGE RING.
	TEST 1,PZ↔GO L0			;TEST FOR EDGE CROSSING.
	TEST 1,NZ↔GO L0

;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
	DOM FLAG			;FIRST TIME THRU FLAG -1.
	DZM ELIST1			;LIST OF VERY SHORT EDGES.
	LAC 1,EDGE
	DAC 1,E↔NVT 2,1↔TEST 2,PZ
	GO[CALL(INVERT,E)↔GO .+1]	;FORCE NVT(E) INTO PZ HALF-SPACE.
	LAC 1,E↔NFACE 1,1
	DAC 1,F0↔DAC 1,F		;FIRST FACE.

;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1:	LAC 1,E↔MARKZ 1,PZ+NZ
	NVT V1,1↔PVT V2,1↔PUSH P,V2↔PUSH P,V1	;SAVE OLDE VERTICES.
	TEST V1,PZ↔GO[CALL(INVERT,E)↔GO .+1]	;FORCE NVT(E) INTO PZZ.
	SETQ(U2,{ESPLIT,E})↔MARK 1,PZ		;PZ HALFSPACE.
	PED 1,1
	LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1	;CONS EDGE INTO ELIST1.
	SETQ(UU2,{ESPLIT,ELIST1})↔MARK 1,NZ	;NZ HALFSPACE.

;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
	POP P,V1↔POP P,V2			;RESTORE OLDE VERTICES.
	LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
	LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
	LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
	LAC ZCUT↔FSBR ZWC(V1)↔FDVR DZ↔LAC 2,U2		;COEFFICIENT K.
	FMPR DX,0↔FADR DX,XWC(V1)↔DAC DX,XWC(1)↔DAC DX,XWC(2)
	FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
	FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)

;FIRST TIME ONLY.
	AOSG FLAG↔GO[LAC U2↔DAC U0
	LAC UU2↔DAC UU0↔GO L2]
;DOUBLE FACE SPLIT.
	CALL(MKFE,U2,F,U1)↔NFACE 1,1
	CALL(MKFE,UU2,1,UU1)

;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2:	LAC U2↔DAC U1↔LAC UU2↔DAC UU1
	SETQ(F,{OTHER,E,F})
	CAMN 1,F0↔GO L4
L3:	SETQ(E,{ECCW,E,F})
	TEST 1,NZ↔GO L3↔GO L1

;DOUBLE CUT LAST (FIRST) FACE.
L4:	CALL(MKFE,U0,F,U1)↔NFACE 1,1
	CALL(MKFE,UU0,1,UU1)
;CONS ELIST1 INTO ELIST
	LAC 1,ELIST1↔LAC 2,ELIST2
	ALT2. 2,1↔DAC 1,ELIST2↔GO L0

DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------
SUBR(SMOOTH,FACE,EPSILON)
	LAC 1,FACE↔PED 1,1
	DAC 1,EDGE0↔DAC 1,EDGE↔SETZ 4,
L0:	SETQ(EDGE,{ECCW,EDGE,FACE})
	CAME 1,EDGE0↔AOJA 4,L0
	SUBI 4,3↔DAC 4,CNT
	LAC 1,FACE↔PED 1,1
	DAC 1,EDGE↔GO L2
L1:	SETQ(VERTEX,{VCCW,EDGE,FACE})
	CALL(VTEST,VERTEX)
	MOVMS 1↔CAMG 1,EPSILON↔GO L2
	SOSGE CNT↔POP2J
	SETQ(EDGE,{KLEV,VERTEX})↔GO L3
L2:	SETQ(EDGE,{ECCW,EDGE,FACE})
L3:	LAC 2,FACE↔PED 0,2
	CAME 0,1↔GO L1
	SETQ(VERTEX,{VCCW,EDGE,FACE})
	CALL(VTEST,VERTEX)
	MOVMS 1↔CAMG 1,EPSILON↔POP2J
	SETQ(EDGE,{KLEV,VERTEX})↔POP2J
DECLARE{EDGE,VERTEX,CNT,EDGE0}
ENDR SMOOTH;---------------------------------------------------------

SUBN(EDGCOE,EDGE)	;EDGE COEFFICIENTS FROM XWC,YWC.
	ACCUMULATORS{E,S,V1,V2}
	LAC E,EDGE↔NVT V1,E↔PVT V2,E
	LAC YWC(V2)↔FSBR YWC(V1)↔DAC AA(E)↔FMPR↔DAC 1
	LAC XWC(V1)↔FSBR XWC(V2)↔DAC BB(E)↔FMPR↔FADR 1,0
	LAC XWC(V2)↔FMPR YWC(V1)
	LAC S,XWC(V1)↔FMPR S,YWC(V2)↔FSBR S↔DAC CC(E)
	CALL(SQRT↑,1)↔DAC 1,8(E)↔SLACI(<1.0>)↔FDVR 0,1
	FMPRM AA(E)↔FMPRM BB(E)↔FMPRM CC(E)
	POP1J
ENDR EDGCOE;7/23/73(BGB)--------------------------------------------

SUBN(QCROSS,EDGE1,EDGE2)
	ACCUMULATORS{E1,E2}
	LAC E1,EDGE1
	LAC E2,EDGE2
	LAC 0,AA(E1)↔FMPR 0,AA(E2)
	LAC 1,BB(E1)↔FMPR 1,BB(E2)↔FADR 1,0
	POP2J
ENDR QCROSS;---------------------------------------------------------

SUBN(VTEST,VERT)
	LAC 1,VERT↔PED 2,1↔DAC 2,E1
	SETQ(E2,{ECCW,E1,VERT})
	CALL(EDGCOE,E1)
	CALL(EDGCOE,E2)
	LAC 1,[1.0]↔LAC 0,[0.01]
	LAC 2,E1↔CAMLE 0,8(2)↔POP1J	;EDGE LENGTH TOO SHORT.
	LAC 2,E2↔CAMLE 0,8(2)↔POP1J
	CALL(QCROSS,E1,E2)↔POP1J	;ANGLE TOO SHARP OR SMOOTH.
DECLARE{E1,E2}
ENDR VTEST;----------------------------------------------------------
SUBN(MKGHOST,OLDSLAB)
;--------------------------------------------------------------------
	ACCUMULATORS{Q,F,V,E,E0,PTR}

;INITIALIZE TWO LISTS.
	LAC F,OLDSLAB			;SLAB'S FACE RING.
	DZM CFLIST			;SMOOTHED CUT FACE LAMINA LIST.
	LACI BUFFER↔DAC VLIST		;NEW VERTICES LIST POINTER.

;RING AROUND THE FACES OF THE OLD SLAB, WHICH IS TO BE REPLACED.
L1:	NFACE F,F↔CAMN F,OLDSLAB↔POP1J
	ALT Q,F↔JUMPE Q,L1↔WIP 6(Q)	;NZ-CUT FACE TEST & CLEAR.
	DAC F,FACE

;COPY OLD CUT FACE INTO A CUT FACE LAMINA WHICH IS THEN SMOOTHED.
	CALL(MKCOPY,FACE)		;CUT FACE LAMINA BODY.
	PFACE 1,1↔DAC 1,LAMINA		;SECOND FACE OF A LAMINA IS OUTWARDS.
	MARK 1,PZ			;...FOR OUTWARDS SIDE.
	CALL(SMOOTH,LAMINA,[0.90])

;PUSH NEW CUT FACE LAMINA INTO THE CUT-FACE LIST.
	LAC 1,LAMINA↔LAC 2,CFLIST
	ALT. 2,1↔DAC 1,CFLIST

;POINTER FOR FINAL SLAB GLUEING IN RESURRECT.
	LAC F,FACE↔ALT Q,F	;CUT FACE AND ITS POSSIBLE MATE.
	TEST F,PZ
	ALT2. 1,Q		;NZ TOP - CUT-FACE Q POINTS AT LAMINA
	ALT2. F,1		;PZ BOTTOM - LAMINA POINTS AT CUT-FACE.

;PUSH THE SURVIVING VERTICES OF THE SMOOTHED CUT-FACE-LAMINA INTO A BUFFER.
	LAC F,LAMINA↔PED E,F
	DAC E,E0↔LAC PTR,VLIST
L2:	SETQ(V,{VCCW,E,F})↔DIP F,V↔PUSH PTR,V
	SETQ(E,{ECCW,E,F})↔CAME E,E0↔GO L2
	DAC PTR,VLIST↔LAC F,FACE
	GO L1

DECLARE{LAMINA,FACE}
ENDR MKGHOST;--------------------------------------------------------
SUBN(DPYF,FACE)
	E←←10↔E0←←11↔V←←12
	LAC E,FACE↔PED E,E↔DAC E,E0
	SETQ(V,{VCW↑,E0,FACE})
	LAC 0,XWC(V)↔FMPR 0,SCALE↔FIXX 0,
	LAC 1,YWC(V)↔FMPR 1,SCALE↔FIXX 1,
	CALL(AIVECT↑,0,1)↔CALL(DPYBRT↑,[2])
L1:	SETQ(V,{VCCW,E,FACE})
	LAC 0,XWC(V)↔FMPR 0,SCALE↔FIXX 0,
	LAC 1,YWC(V)↔FMPR 1,SCALE↔FIXX 1,↔CALL(AVECT↑,0,1,0,1)

;CLOSEST ALEIN MATE OF A VERTEX.
	CCW V,V↔JUMPE V,L2↔CALL(DPYBRT↑,[5])
	LAC 0,XWC(V)↔FMPR 0,SCALE↔FIXX 0,
	LAC 1,YWC(V)↔FMPR 1,SCALE↔FIXX 1,↔CALL(AVECT↑,0,1)

	CALL(DPYBRT↑,[2])
L2:	CALL(AIVECT)
	SETQ(E,{ECCW,E,FACE})
	CAME E,E0↔GO L1
	POP1J
SCALE:	1000.0
ENDR DPYF;-----------------------------------------------------------

SUBN(DPYALL)
	LAC 1,CFLIST↔DAC 1,LIST#
	CALL(DPYSET↑,DPYBUF↑)
L0:	SKIPE 1,LIST↔GO L1
	CALL(DPYOUT↑,[1])
	INCHRW↔POP0J
L1:	CALL(DPYF,LIST)
	LAC 1,LIST↔ALT 1,1↔DAC 1,LIST		;ADVANCE CUT FACE LIST.
	GO L0
ENDR DPYALL;---------------------------------------------------------
SUBN(DPYVV,V1,V2)
	LAC[XWD 1,TMP1]↔BLT TMP1+11
	CALL(GEODPY)
	CALL(DPYSET↑,DPYBUF↑)
	LAC 2,V1↔XDC 0,2↔YDC 1,2↔FIXX 0,↔FIXX 1,
	SUBI 0,12↔SUBI 1,4
	CALL(AIVECT↑,0,1)↔CALL(DTYO↑,["1"])
	LAC 2,V2↔XDC 0,2↔YDC 1,2↔FIXX 0,↔FIXX 1,
	SUBI 0,12↔SUBI 1,4
	CALL(AIVECT↑,0,1)↔CALL(DTYO↑,["2"])
	CALL(DPYOUT,[3])
	LAC[XWD TMP1,1]↔BLT 1+11
	POP2J
TMP1:	BLOCK 17
ENDR DPYVV
SUBN(VMATE)
;MATE EACH VERTEX WITH THE CLOSEST ALEIN VERTEX IN THE CCW LINK.
	ACCUMULATORS{PTR1,PTR2,V1,V2,X,Y,V,ZMIN,F}

	LAC PTR1,VLIST
	LACI BUFFER↔DAC EOL#

L1:	CAMN PTR1,EOL↔POP0J
	POP PTR1,V1				;FOR EACH VERTEX.
	CAR F,V1↔ZIP V1				;DOMESTIC FACE.
	HRLI ZMIN,377777↔DZM V 			;INITIAL MINIMUM
	LAC PTR2,VLIST

L2:	CAMN PTR2,EOL↔GO L3↔POP PTR2,V2		;FOR ALL THE OTHERS.
	CAR 0,V2↔CAMN 0,F↔GO L2			;TEST FOR ALEIN FACE.
	LAC X,XWC(V2)↔FSB X,XWC(V1)↔FMPR X,X	;DISTANCE MEASURE.
	LAC Y,YWC(V2)↔FSB Y,YWC(V1)↔FMPR Y,Y
	FADR X,Y↔CAML X,ZMIN↔GO L2		;TEST FOR MINIMUM.
	DAC V2,V↔DAC X,ZMIN↔GO L2		;NEW MINIMA V MATE.
L3:	CCW. V,V1↔GO L1				;MATE TWO VERTICES.

ENDR VMATE;1/26/74(BGB)----------------------------------------------
SUBN(RESURRECT)
	ACCUMULATORS{V1,V2,E,E0,PTR,F1,F2}

;LINK EACH VERTEX WITH ITS MATE BY MEANS OF AN EDGE.
L0:	DZM FLAGVV
	LAC PTR,VLIST↔DAC PTR,PTRSAV#

L1:	LAC PTR,PTRSAV
	CAIN PTR,BUFFER↔GO L6
	POP PTR,V1↔DAC PTR,PTRSAV

	ZIP V1					;CLEAR FACE HALF.
	CCW V2,V1↔JUMPE V2,L1			;IS THERE A MATE ?
	CALL(LINKED↑,V1,V2)↔JUMPN 1,L1		;COMMON EDGE ALREADY ?
	CALL(GLUEVV,V1,V2)↔GO L1

;GLUE THE NEW SLAB INTO THE NEW BODY.
L6:	SKIPE FLAGVV↔GO L0
	LAC CFLIST↔DAC FACE#
L7:	SKIPN F1,FACE↔GO L8		;TEST FOR END OF CFLIST.
	ALT F2,F1↔DAC F2,FACE		;SAVE FOR NEXT TIME.
	ALT2 F2,F1
	ALT2 F2,F2↔JUMPE F2,L7
	CALL(GLUE↑,F1,F2)↔GO L7

L8:	LAC 1,BUFFER+1
	PED 1,1↔CCW 1,1			;RETURN LATEST BODY.
	POP0J

ENDR RESURRECT;1/27/74(BGB)------------------------------------------
SUBN(GLUEVV,VERT1,VERT2)
	ACCUMULATORS{V1,V2,F1,F2,E,E0}

;TEST WHETHER THE VERTICES ARE ON THE SAME BODY.
	LAC V1,VERT1↔PED 1,V1↔CCW  0,1		;BGET(V1).
	LAC V2,VERT2↔PED 1,V2↔CCW  1,1		;BGET(V2).
	CAME 0,1↔GO L4				;TEST COMMON BODY ?

;FIND COMMON FACE OF V1 AND V2; AND MAKE A NEW FACE & EDGE.
	PED E,V1↔DAC E,E0↔GO L3
L2:	SETQ(E,{ECCW,E,V1})
	CAMN E,E0↔POP2J
L3:	SETQ(F1,{FCCW,E,V1})
	CALL(LINKED,F1,V2)↔JUMPE 1,L2

;AVOID THE STING OF THE FUCKING WASP EDGES.

	PED E,V1↔DAC E,E0
L3A:	TESTZ E,WASP↔GO[SETOM FLAGVV↔POP2J]
	SETQ(E,{ECCW,E,V1})↔CAME E,E0↔GO L3A

	PED E,V2↔DAC E,E0
L3B:	TESTZ E,WASP↔GO[SETOM FLAGVV↔POP2J]
	SETQ(E,{ECCW,E,V2})↔CAME E,E0↔GO L3B

	CALL(MKFE,V1,F1,V2)↔POP2J

;VERTICES HAVE DIFFERENT BODIES, GLUE EDGE.
L4:	PED E,V1↔		SETQ(F1,{FCCW,E,V1})
	TEST F1,PZ↔GO L5↔	SETQ(F1,{FCW,E,V1})
	TESTZ F1,PZ↔HALT
L5:	PED E,V2↔		SETQ(F2,{FCCW,E,V2})
	TEST F2,PZ↔GO L6↔	SETQ(F2,{FCW,E,V2})
	TESTZ F2,PZ↔HALT
L6:	CALL(GLUEE↑,F1,V1,F2,V2)
	POP2J
ENDR GLUEVV;---------------------------------------------------------
DECLARE{FLAGVV}
END